c###esmod.for
      SUBROUTINE ESMOD
C--------------------------------
C
C     THIS ROUTINE FINDS SPORADIC E MODE AND LOSS INFORMATION
C     (SAME AS SUBROUTINE REGMOD FOR THE OTHER LAYERS)
C
C AC(3) IS ABSORPTION LOSS FACTOR, SEE LUFFY.
C BC(3) IS DENOMINATOR OF LOSS FACTOR.
c
      COMMON/ANOIS/ATNU,ATNY,CC,TM,RCNSE,DU,DL,SIGM,SXGU,SXGL,KJ,JK
      COMMON / CONTRL / IELECT(3), KTOUT(12), MONTHS(12), SUNSP(12),
     A IANTOU, ICARD, INTEG, IRED, ISOUT, ISPROC, ISSN, ITYPE, JDASH,
     B JFREQ, JLONG, KCARD, KRUN, MAPIN, MAXNAM, MONOLD, MOREM, MORES,
     C NUMNAM, NUPROC, MAXMET, MSPEC, M100
      COMMON/SIGD/ DSL,ASM,DSU,AGLAT,DSLF,ASMF,DSUF,ACAV,FEAV,AFE,BFE
     A ,HNU,HTLOSS,XNUZ,XVE
      COMMON/MUFS/EMUF(24),F1MUF(24),F2MUF(24),ESMUF(24),ALLMUF(24),FOT
     A(24),XLUF(24),HPF(24),ANGMUF(24),MODMUF,SIGL(4),SIGU(4),DELMUF(4)
     B ,HPMUF(4),HTMUF(4),FVMUF(4),AFMUF(4),NHOPMF(4),YFOT(4),YHPF(4)
     C ,YMUF(4)
      COMMON /CON /D2R, DCL, GAMA, PI, PI2, PIO2, R2D, RZ, VOFL
      COMMON /DON /ALATD, AMIN, AMIND, BTR, BTRD, DLONG, DMP, ERTR, GCD,
     1 GCDKM, PMP, PWR, TLAT, TLATD, TLONG, TLONGD, RSN, SIGTR, RLAT,
     2 RLATD,RLONG,RLONGD,BRTD,FLUX,ULAT,ULATD,ULONG,ULONGD,SSN,D90R,
     3 D50R,D10R,D90S,D50S,D10S
      COMMON /RON /CLAT(5), CLONG(5), GLAT(5), RD(5), FI(3,5), YI(3,5),
     1HI(3,5), HPRIM(30,5), HTRUE(30,5), FVERT(30,5),KM,KFX, AFAC(30,5),
     2HTR(50,3), FNSQ(50,3)
      COMMON / ZON / ABPS(7), CREL(7), EFF(7), FLDST(7), GRLOS(7),
     1 HN(7), HP(7), PROB(7), RELY(7), RGAIN(7), SIGPOW(7), SN(7),
     2 SPRO(7), TGAIN(7), TIMED(7), TLOSS(7), B(7), FSLOS(7), ADV(7),
     3 OBF(7),NMODE(7),TLLOW(7),TLHGH(7)
      COMMON /TON /ADJ, ADS, GNOS, GOT, REL, SL, SLS
     1, SPR, SU, SUS, XNOISE, ZNOISE, NF
      COMMON/FRQ/FREA(13),FREL(29),FREQ,JMODE,ITXRCP(2)
      COMMON /ES /FS (3, 5), HS (5)
      COMMON /GEOG /GYZ (5), RAT (5), GMDIP (5), CLCK (5), ABIY (5), ART
     1IC (5), SIGPAT (5), EPSPAT (5)
      COMMON / RAYS / ANG(40), IFOB(40,30,5), NANG
C ES MODES
C     ONE SAMPLE MODEL
      K=1
C.....SELECT SAMPLE AREA - ALL MODES WILL BE AT LEAST THIS GOOD
      DO 95 IS = 1,KM
      IF( FS(2,K) - FS(2,IS) ) 95,95,90
   90 K= IS
   95 CONTINUE
C.....MAPS ARE ES OR E - DO NOT USE AT LOW END
      FSDEAD = IFOB(1,3,JMODE)
      FSDEAD = FSDEAD /1000.
      FSDEAD = AMIN1(FSDEAD,3.)
C.....ONLY 2 ES MODES - PRESET ARRAYS
      DO 97 IHT = 4,5
      OBF(IHT)  = 1000.
      ADV(IHT)  = 1000.
      FSLOS(IHT)  = 1000.
      TLOSS(IHT)  = 1000.
      ABPS (IHT)  = 1000.
      EFF  (IHT)  = 0.0
      GRLOS(IHT)  = 1000.
      RGAIN(IHT)  = 0.0
      TGAIN(IHT)  = 0.0
      HN   (IHT)  = -1.
      PROB (IHT)  = 0.001
      CREL (IHT)  = -1000.
      RELY (IHT)  = .001
      SPRO (IHT)  = 0.001
      FLDST(IHT)  = -1000.
      SIGPOW(IHT)  = -1000.
      SN(IHT)     = -1000.
      HP(IHT)     =  -1.
      B (IHT)     =  -1.
      NMODE(IHT)  =   5
      TLLOW(IHT)  =  10.
      TIMED(IHT) = -1.
      TLHGH(IHT)  = 10.
   97 CONTINUE
      IF(FREQ.le.FSDEAD) return
      IF(FS(2,K).le.0.) return
C.....VIRTUAL HEIGHTS SAME AS TRUE HEIGHTS
      SDMAX = 2.*RZ*(PIO2 - ASIN(1./(1.+ HS(K)/RZ) ) )
      IHSRT = GCDKM/SDMAX + 1.
      IHSTP = 2
C.....DO ONLY 2 Es HOPS
      IF(IHSRT .gt.2) return
      IH =3
C.....ABSORPTION LOSS - F2 MODE
      AC = 677.2 * ACAV/ ( (FREQ + GYZ(K)) ** 1.98  + 10.2 )
      DO 150 IHOP = IHSRT, IHSTP
      IH = IH + 1
      GP = IHOP
      GHOP = GCD / GP
      THET = 0.5 * GHOP
      TANS=SIN(THET)/(1.-COS(THET)+HS(K)/RZ)
      PSI=ATAN(TANS)
      SECS=1./COS(PSI)
      SFVMOD = FREQ/SECS
C.....MUF AT THIS HOP DISTANCE
      ESD=FS(2,K)*SECS
      DEL=PIO2-THET-PSI
      CDEL = COS (DEL)
      ADEL = DEL * R2D
      IF(ADEL.lt.AMIND)  go to 150
C.....GROUP PATH
      PATH = 2. * SIN (.5 * GHOP) * (RZ + HS (K)) / CDEL
      HOP = IHOP
      PATH = HOP * PATH
C.....FREE SPACE LOSS
      SFLOS = 32.45 + 20.*ALOG10(PATH * FREQ)
      SINP = RZ * CDEL / (RZ + 100.)
      COSP = SQRT(1. - SINP * SINP)
      SABPS = AC/COSP
      ADX =0.0
C.....CHECK IF Es LAYER < E LAYER (IF YES REMOVE E LAYER BENDING ABOVE HS)
      if(FI(1,K).gt.SFVMOD) ADX=AFE + BFE*ALOG(SFVMOD/FI(1,K) )
      SABPS = SABPS + ADX
C.....PROBABILITY OF REFLECTION
      DUMMY = YMUF(4)
      PROS = PRBMUF(FREQ,ESD,DUMMY,4)
C.....LIMIT LOSS
      PROS = AMIN1(PROS,.90)
      REF = 8.9136 * PROS ** (-0.7)
C.....LOWER DECILE FOR LOSS USE FOT
      ESD  = FS(1,K) * SECS
      DUMMY = YFOT(4)
      PS = PRBMUF(FREQ,ESD,DUMMY,4)
      PS = AMIN1(PS,.9)
      REFL = 8.9136 * PS ** (-0.7)
C.....UPPER DECILE -   HPF
      ESD =  FS(3,K)* SECS
      DUMMY = YHPF(4)
      PS = PRBMUF(FREQ,ESD,DUMMY,4)
      PS  = AMIN1(PS,.9)
      REFU = 8.9136 * PS ** (-0.7)
C.....LOWER DECILE WITH AURORAL
      TLLOW(IH) = DSL + HOP * (REFL - REF)
C.....UPPER DECILE WITH AURORAL
      TLHGH(IH) = DSU + HOP * (REF - REFU)
C.....MAXIMUM OBSERVED IS 25.
      TLLOW(IH) = AMIN1(TLLOW(IH),25.)
      TLHGH(IH) = AMIN1(TLHGH(IH),25.)
      Y = 0.0
C.....GROUND LOSS
      DO 130 IG = 1,KM
      IGX = -IG
      CALL GAIN(IGX,DEL,FREQ,YG,GEFF)
  130 Y = Y + YG
      XKM = KM
      SGRLOS = Y / XKM
C.....ANTENNAS
C125PC      if(MSPEC.ne.125)then
        CALL GAIN(1,DEL,FREQ,STGAIN,STEFF)
        CALL GAIN(2,DEL,FREQ,SRGAIN,DUMMY)
        EFF(IH) = DUMMY
C125PC      else
c.......set gains and EFF to 0 dB or unity
C125PC        stgain=0.
C125PC        srgain=0.
C125PC        EFF(ih)=0.
C125PC      ENDIF
      xtlos = SFLOS + HOP*(SABPS + REF + ADX ) + (HOP -1.) * SGRLOS
     A    - SRGAIN  - STGAIN  + ASM
C.....FIELD STRENGTH
      FLDST(IH) = 107.2 + PWRDB(FREQ) + 20.*ALOG10(FREQ)-XTLOS-SRGAIN
C.....MEDIAN SIGNAL POWER
      SIGPOW(IH) = PWRDB(FREQ) - XTLOS
      DUMMY = YMUF(4)
      PROS = PRBMUF(FREQ,DUMMY,DUMMY,4)
      IHT = IH
C.....OBSCURATION FOR F LAYER NOT USED
      OBF(IHT)    =  + 8.9136*PROS ** (-0.7)
C.....DEVIATION LOSS
      ADV(IHT)    = 0.0
C.....FREE SPACE
      FSLOS(IHT)  =  SFLOS
C.....MEDIAN TRANSMISSION LOSS
      TLOSS(IHT)  =  XTLOS
C.....ABSORPTION LOSS
      ABPS (IHT)  =  AC/COSP + ADX
C.....GROUND LOSS
      GRLOS(IHT)  =  SGRLOS
C.....ANTENNA GAINS
      RGAIN(IHT)  = SRGAIN
      TGAIN(IHT)  = STGAIN
      HN(  IHT)  = HOP
C.....SIGNAL POWER
      SIGPOW(IHT) = PWRDB(FREQ) - XTLOS
C.....SIGNAL-TO-NOISE RATIO
C------------    CHANGED 9/24/91  (LONG PATH RCVR EFF CORRECTION)  FJR
C------------            SN    (IHT) = SIGPOW(IHT) - RCNSE
      SN    (IHT) = SIGPOW(IHT) - RCNSE - EFF(IHT)
C.....HEIGHT
      HP    (IHT) = HS(K)
C.....RADIATION ANGLE
      B     (IHT) =  ADEL
C.....MODE
      NMODE (IHT) =  4
C.....F. DAYS
      PROB  (IHT) =  PROS ** IHOP
C.....TIME DELAY
      TIMED (IHT) =  PATH/VOFL
  150 CONTINUE
      RETURN
      END
C--------------------------------
